Attribute VB_Name = "modHourGlass"
'***************************************************************
' (c) Copyright 2000 Matthew J. Curland
'
' This file is from the CD-ROM accompanying the book:
' Advanced Visual Basic 6: Power Techniques for Everyday Programs
'   Author: Matthew Curland
'   Published by: Addison-Wesley, July 2000
'   ISBN: 0-201-70712-8
'   http://www.PowerVB.com
'
' You are entitled to license free distribution of any application
'   that uses this file if you own a copy of the book, or if you
'   have obtained the file from a source approved by the author. You
'   may redistribute this file only with express written permission
'   of the author.
'
' This file depends on:
'   References:
'     VBoostTypes6.olb (VBoost Object Types (6.0))
'     VBoost6.Dll (VBoost Object Implementation (6.0)) (optional)
'   Files:
'     VBoost.Bas (optional)
'   Minimal VBoost conditionals:
'     VBOOST_INTERNAL = 1 : VBOOST_CUSTOM = 1
'   Conditional Compilation Values:
'     NOVBOOST = 1 'Removes VBoost dependency
'
' This file is discussed in Chapter 8.
'***************************************************************
Option Explicit

Private Type HourGlassVTable
    VTable(2) As Long
End Type

Private m_VTable As HourGlassVTable
Private m_pVTable As Long

Public Type HourGlass
    pVTable As Long
    pThisObject As IUnknown
    PrevCursor As Long
End Type

Public Sub ShowHourGlass(HG As HourGlass)
Dim PrevCursor As Long
    If m_pVTable = 0 Then
        With m_VTable
            .VTable(0) = FuncAddr(AddressOf QueryInterface)
            .VTable(1) = FuncAddr(AddressOf AddRef)
            .VTable(2) = FuncAddr(AddressOf Release)
            m_pVTable = VarPtr(.VTable(0))
        End With
    End If
    
    With Screen
        PrevCursor = .MousePointer
        If PrevCursor <> vbHourglass Then
            .MousePointer = vbHourglass
            With HG
                .PrevCursor = PrevCursor
                .pVTable = m_pVTable
                #If NOVBOOST Then
                    CopyMemory .pThisObject, VarPtr(.pVTable), 4
                #Else
                    VBoost.Assign .pThisObject, VarPtr(.pVTable)
                #End If
            End With
        End If
    End With
End Sub

Private Function QueryInterface(This As HourGlass, riid As Long, pvObj As Long) As Long
    Debug.Assert False 'QI not expected
    pvObj = 0
    QueryInterface = E_NOINTERFACE
End Function
Private Function AddRef(This As HourGlass) As Long
    Debug.Assert False 'No need to addref
End Function
Private Function Release(This As HourGlass) As Long
    With Screen
        If .MousePointer = vbHourglass Then .MousePointer = This.PrevCursor
    End With
End Function
Private Function FuncAddr(ByVal pfn As Long) As Long
    FuncAddr = pfn
End Function

